home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Library-2.01 / graphic-items.Lisp < prev    next >
Encoding:
Text File  |  1993-09-16  |  3.8 KB  |  123 lines  |  [TEXT/CCL2]
  1. ;;-*- Mode: Lisp; Package: CCL -*-
  2. ;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;;  graphic-items.lisp
  5. ;;
  6. ;;  ©1989, Apple Computer, Inc
  7. ;;
  8. ;;
  9. ;;  an abstract class of dialog-items which display, but can't be clicked.
  10. ;;  graphic-dialog-items work by defining point-in-item-p to always
  11. ;;  return nil.
  12. ;;
  13. ;;  title-box-dialog-items are a sub-class of graphic-dialog-items which
  14. ;;  are used for putting frames around areas in dialogs
  15. ;;
  16.  
  17. ;;;;;;;;;;;;;;;;;;;;
  18. ;;
  19. ;; Change History
  20. ;;
  21. ;; 04/28/93 mwp Release
  22. ;; 04/07/92 bill The interface-designer package is no more
  23. ;;-------------- 2.0
  24. ;; 10/15/91 bill window-font -> view-font
  25. ;;-------------- 2.0b3
  26. ;; 07/09/91 bill (provide 'graphic-items)
  27. ;;-------------- 2.0b2
  28.  
  29. (in-package :ccl)
  30.  
  31. (eval-when (:compile-toplevel :load-toplevel :execute)
  32.   (export '(graphic-dialog-item title-box-dialog-item) :ccl))
  33.  
  34. (defclass graphic-dialog-item (dialog-item)
  35.   ())
  36. (defclass title-box-dialog-item (graphic-dialog-item)
  37.   ((title-box-width :initform 0 :accessor title-box-width)))
  38.  
  39. ;;;;;;;;;;;;;;;;;;;;;;
  40. ;;
  41. ;; graphic-dialog-items redefine point-in-click-region-p so that the
  42. ;; items aren't clickable (i.e., they never cover up other items)
  43. ;;
  44.  
  45. (defmethod point-in-click-region-p ((item graphic-dialog-item) point)
  46.   (if (and (editing-dialogs-p (view-window item))
  47.            (call-next-method))
  48.       (progn
  49.         (do-dialog-items (item (view-container item))
  50.           (unless (inherit-from-p item 'graphic-dialog-item)
  51.             (when (view-contains-point-p item point)
  52.               (return-from point-in-click-region-p nil))))
  53.         t)
  54.       nil))
  55.  
  56.  
  57. ;;;;;;;;;;;;;;;;;;;;;;
  58. ;;
  59. ;;  title-box-dialog-items are used for putting named frames around
  60. ;;  areas in a dialog.
  61. ;;
  62.  
  63. (defmethod install-view-in-window ((item title-box-dialog-item) dialog)
  64.   (let* ((topleft (view-position item))
  65.          (bottomright (add-points topleft (view-size item))))
  66.     (rlet ((r :rect :topleft topleft
  67.               :bottomright bottomright))
  68.       (rset r :rect.top (- (rref r :rect.top) 8))
  69.       (#_InvalRect :ptr r)))
  70.   (call-next-method)
  71.   (setf (title-box-width item)
  72.         (string-width (dialog-item-text item)
  73.                       (or (view-font item)
  74.                           (view-font dialog)))))
  75.  
  76. (defmethod set-view-font ((item title-box-dialog-item) new-font-spec)
  77.   (setf (title-box-width item)
  78.         (string-width (dialog-item-text item) new-font-spec))
  79.   (call-next-method)
  80.   (invalidate-view item))
  81.  
  82. (defmethod set-dialog-item-text ((item title-box-dialog-item) new-text)
  83.   (let ((my-dialog (view-window item)))
  84.     (when my-dialog
  85.       (setf (title-box-width item)
  86.             (string-width new-text
  87.                           (or (view-font item)
  88.                               (view-font my-dialog))))
  89.       (call-next-method)
  90.       (view-focus-and-draw-contents item))))
  91.  
  92. (defmethod view-draw-contents ((item title-box-dialog-item))
  93.   (let* ((topleft (view-position item))
  94.          (bottomright (add-points topleft (view-size item))))
  95.     (with-pstrs ((p-title (dialog-item-text item)))
  96.       (rlet ((r :rect :topleft topleft
  97.                 :bottomright bottomright))
  98.         (#_FrameRect :ptr r)
  99.         (rset r rect.left (+ (rref r rect.left) 4))
  100.         (rset r rect.bottom (+ (rref r rect.top) 2))
  101.         (rset r rect.right (+ (rref r rect.left)
  102.                               4
  103.                               (title-box-width item)))
  104.         (#_EraseRect :ptr r))
  105.       (#_MoveTo :long (add-points topleft #@(6 5)))
  106.       (#_DrawString :ptr p-title))))
  107.  
  108. (provide 'graphic-items)
  109.  
  110.  
  111. #|
  112.  
  113. (setq my-box (make-instance 'title-box-dialog-item
  114.                             :dialog-item-text "Buttons"
  115.                             :view-position #@(20 20)
  116.                             :view-size #@(100 100)))
  117.  
  118. (setq my-dialog (make-instance 'dialog
  119.                                :view-size #@(200 125)
  120.                                :view-subviews (list my-box)))
  121.  
  122. |#
  123.